In [1]:
from notebook_preamble import J, V, define
Consider the x combinator x == dup i:
[a B] x
[a B] a B
Let B swap the a with the quote and run some function [C] on it.
[a B] a B
[a B] a swap [C] dip
a [a B] [C] dip
a C [a B]
Now discard the quoted a with rest and cons the result of C on a whatever that is:
aC [a B] rest cons
aC [B] cons
[aC B]
Altogether, this is the definition of B:
B == swap [C] dip rest cons
We can create a quoted program that generates the Natural numbers (integers 0, 1, 2, ...) by using 0 for a and [dup ++] for [C]:
[0 swap [dup ++] dip rest cons]
Let's try it:
In [2]:
V('[0 swap [dup ++] dip rest cons] x')
After one application of x the quoted program contains 1 and 0 is below it on the stack.
In [3]:
J('[0 swap [dup ++] dip rest cons] x x x x x pop')
In [4]:
define('direco == dip rest cons')
In [5]:
V('[0 swap [dup ++] direco] x')
We want to go from:
a [C] G
to:
[a swap [C] direco]
Working in reverse:
[a swap [C] direco] cons
a [swap [C] direco] concat
a [swap] [[C] direco] swap
a [[C] direco] [swap]
a [C] [direco] cons [swap]
Reading from the bottom up:
G == [direco] cons [swap] swap concat cons
G == [direco] cons [swap] swoncat cons
We can try it out:
0 [dup ++] G
In [6]:
define('G == [direco] cons [swap] swoncat cons')
In [7]:
V('0 [dup ++] G')
In [8]:
V('0 [dup ++] G x')
In [9]:
J('1 [dup 1 <<] G x x x x x x x x x')
In [10]:
J('23 [dup ++] G 5 [x] times pop')
We can use dip to untangle [dup ++] G from the arguments.
In [11]:
J('23 5 [[dup ++] G] dip [x] times pop')
Now that the givens (arguments) are on the left we have the definition we're looking for:
In [12]:
define('n_range == [[dup ++] G] dip [x] times pop')
In [13]:
J('450 10 n_range')
This is better just using the times combinator though...
In [14]:
J('450 9 [dup ++] times')
Look at the treatment of the Project Euler Problem One in Developing a Program.ipynb and you'll see that we might be interested in generating an endless cycle of:
3 2 1 3 1 2 3
To do this we want to encode the numbers as pairs of bits in a single int:
3 2 1 3 1 2 3
0b 11 10 01 11 01 10 11 == 14811
And pick them off by masking with 3 (binary 11) and then shifting the int right two bits.
In [15]:
define('PE1.1 == dup [3 &] dip 2 >>')
In [16]:
V('14811 PE1.1')
If we plug 14811 and [PE1.1] into our generator form...
In [17]:
J('14811 [PE1.1] G')
In [18]:
J('[14811 swap [PE1.1] direco] x')
...we get a generator that works for seven cycles before it reaches zero:
In [19]:
J('[14811 swap [PE1.1] direco] 7 [x] times')
In [20]:
define('PE1.1.check == dup [pop 14811] [] branch')
In [21]:
J('[14811 swap [PE1.1.check PE1.1] direco] 21 [x] times')
In [22]:
J('7 66 * 4 +')
If we drive our generator 466 times and sum the stack we get 999.
In [23]:
J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times')
In [24]:
J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times pop enstacken sum')
In [25]:
define('PE1.2 == + dup [+] dip')
Now we can add PE1.2 to the quoted program given to times.
In [26]:
J('0 0 [0 swap [PE1.1.check PE1.1] direco] 466 [x [PE1.2] dip] times popop')
Or using G we can write:
In [27]:
J('0 0 0 [PE1.1.check PE1.1] G 466 [x [PE1.2] dip] times popop')
Consider:
[b a F] x
[b a F] b a F
The obvious first thing to do is just add b and a:
[b a F] b a +
[b a F] b+a
From here we want to arrive at:
b [b+a b F]
Let's start with swons:
[b a F] b+a swons
[b+a b a F]
Considering this quote as a stack:
F a b b+a
We want to get it to:
F b b+a b
So:
F a b b+a popdd over
F b b+a b
And therefore:
[b+a b a F] [popdd over] infra
[b b+a b F]
And lastly:
[b b+a b F] uncons
b [b+a b F]
Done.
Putting it all together:
F == + swons [popdd over] infra uncons
And:
fib_gen == [1 1 F]
In [28]:
define('fib == + swons [popdd over] infra uncons')
In [29]:
define('fib_gen == [1 1 fib]')
In [30]:
J('fib_gen 10 [x] times')
By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms.
Now that we have a generator for the Fibonacci sequence, we need a function that adds a term in the sequence to a sum if it is even, and pops it otherwise.
In [31]:
define('PE2.1 == dup 2 % [+] [pop] branch')
And a predicate function that detects when the terms in the series "exceed four million".
In [32]:
define('>4M == 4000000 >')
Now it's straightforward to define PE2 as a recursive function that generates terms in the Fibonacci sequence until they exceed four million and sums the even ones.
In [33]:
define('PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec')
In [34]:
J('PE2')
Here's the collected program definitions:
fib == + swons [popdd over] infra uncons
fib_gen == [1 1 fib]
even == dup 2 %
>4M == 4000000 >
PE2.1 == even [+] [pop] branch
PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec
In [35]:
J('[1 0 fib] x x x') # To start the sequence with 1 1 2 3 instead of 1 2 3.
Drive the generator three times and popop the two odd terms.
In [36]:
J('[1 0 fib] x x x [popop] dipd')
In [37]:
define('PE2.2 == x x x [popop] dipd')
In [38]:
J('[1 0 fib] 10 [PE2.2] times')
Replace x with our new driver function PE2.2 and start our fib generator at 1 0.
In [39]:
J('0 [1 0 fib] PE2.2 [pop >4M] [popop] [[PE2.1] dip PE2.2] primrec')